home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / LISP Related / MCL Utilities / Sound Manager / tone-synth.lisp < prev   
Encoding:
Text File  |  1990-09-04  |  2.3 KB  |  85 lines  |  [TEXT/CCL ]
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;; Copyright 1987, 1988, 1989, 1990 by Ruben Kleiman for Apple Computer, Inc.
  3. ;;; Advanced Technology Group
  4. ;;;
  5.  
  6. ;;;
  7. ;;; Tone Synthetizer sound functions
  8. ;;;
  9.  
  10. (in-package :sound)
  11.  
  12. (require :sound-info)
  13.  
  14. (provide :tone-synth)
  15.  
  16. (export '(do-pitch using-channel using-command with-command-setting
  17.           do-command-on-channel))
  18.  
  19. (defun do-pitch (&key (a #xFF) (f #x3C) (d 40))
  20.   (%stack-block ((channel 4)
  21.                  (cmd 8))
  22.     (%put-long channel 0 0)   ; make sure that channel is a nil ptr
  23.     
  24.     (_SndNewChanne :ptr channel :word 1 :long 0 :ptr nil :word) ;; sound::noteSynth
  25.     
  26.     (%put-word cmd 40 0)
  27.     (%put-word cmd d 2)
  28.     (%put-byte cmd a 4)
  29.     (%put-byte cmd #x00 5)
  30.     (%put-byte cmd #x00 6)
  31.     (%put-byte cmd f 7)
  32.     
  33.     (with-pointers ((p cmd))
  34.       (_SndDoCommand :ptr (%get-ptr channel 0)
  35.                             :ptr p ; (%get-ptr SndCommand 0)
  36.                             :word 0
  37.                             :word))
  38.     
  39.     (_SndDisposeChannel :ptr (%get-ptr channel 0) :word 0)))45987351
  40.  
  41.  
  42. ;;; MACROS will be needed for smoother transitions between notes [see TEST]
  43.  
  44. (defmacro using-channel ((channel channel-type) &body body)
  45.   `(%stack-block ((,channel 4))
  46.      (%put-long ,channel 0 0)
  47.      (_SndNewChanne :ptr ,channel :word 1 :long 0 :ptr nil :word)
  48.      ,@body
  49.      (_SndDisposeChannel :ptr (%get-ptr ,channel 0) :word 0)))
  50.  
  51. (defmacro using-command ((command) &body body)
  52.   `(%stack-block ((,command 8))
  53.      ,.body))
  54.  
  55. (defmacro with-command-setting ((cmd-ptr type param1 param2) &body body)
  56.   `(progn
  57.      (%put-word ,cmd-ptr ,type 0)
  58.      (%put-word ,cmd-ptr ,param1 2)
  59.      (%put-full-long ,cmd-ptr ,param2 4)
  60.      ,.body))
  61.  
  62. (defmacro do-command-on-channel ((cmd channel))
  63.   `(with-pointers ((p ,cmd))
  64.      (_SndDoCommand :ptr (%get-ptr ,channel 0)
  65.                     :ptr p
  66.                     :word 0
  67.                     :word)))
  68.  
  69.  
  70. (defun test ()
  71.   (using-channel (c 1)
  72.     (using-command (cmd)
  73.       (do ((i 50 (1+ i)))
  74.           ((> i 127))
  75.         (with-command-setting (cmd 40 1000 
  76.                                    (logior #xFF000000
  77.                                            i))
  78.           (print (list cmd c))
  79.           (do-command-on-channel (cmd c)))))))
  80.  
  81.  
  82.  
  83.  
  84.  
  85.